home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Chip 1996 September
/
CHIP 1996 szeptember (CD07).zip
/
CHIP_CD07.ISO
/
sac
/
pack
/
vblha1.lzh
/
MAIN.BAS
< prev
next >
Wrap
BASIC Source File
|
1995-05-09
|
3KB
|
179 lines
Declare Function lha Lib "lha.dll" (ByVal szCmdLine As String, ByVal szOutPut As String, ByVal isize As Integer) As Integer
Declare Function LhaGetVersion Lib "lha.dll" () As Integer
Declare Function LhaSetCursorMode Lib "lha.dll" (ByVal curmode As Integer) As Integer
Global Const fMain = 0
Global Const fGet = 1
'Declare file type
Type fileinfo
lopen As String ' LZH file name
fopen As String ' opened file name
End Type
Type PersonInfo
ID As String * 30
Name As String * 30
Fname As String * 2
Fext As String * 3
Memo As String * 10
End Type
Type directories
Sdir As String * 50
End Type
Global buffer As String
Global cmd As String
Global szbuff As Integer
Global workfile As fileinfo
Global Filenum As Integer
Global curForm As Integer
Global FileDir As directories
Sub main ()
Dim retcode
'Set size of buffer
szbuff = 4052
'Show Tao cursor while in LHA operation
retcode = LhaSetCursorMode(1)
'Display main form
curForm = fMain
frmMain.Show
FileDir.Sdir = "c:\winterm\senddir\"
End Sub
Sub procDel ()
If curForm = fGet Then
If frmGetFile.txtFileName.Text = "" Then
Exit Sub
End If
Else
If frmGetFile.Tag = "" Then
curForm = fGet
frmGetFile.Show 1
curForm = fMain
If frmGetFile.Tag = "" Then
Exit Sub
End If
End If
End If
'Insert drive and path name
procInsPath
'Delete file
Kill frmGetFile.Tag
'Clear file name
frmGetFile.txtFileName.Text = ""
'Clear text area
frmMain.txtWorkarea.Text = ""
frmMain.Caption = ""
'Reset filenames
workfile.lopen = ""
workfile.fopen = ""
frmGetFile.filFiles.Refresh
End Sub
Sub procInsPath ()
Dim retcode As Integer
'Make sure that path ends with backslash
If Right$(frmGetFile.filFiles.Path, 1) <> "\" Then
Path = frmGetFile.filFiles.Path + "\"
Else
Path = frmGetFile.filFiles.Path
End If
'Extract the path and name of the selected file
If frmGetFile.txtFileName.Text = frmGetFile.filFiles.FileName Then
pathandname = Path + frmGetFile.filFiles.FileName
Else
retcode = InStr(frmGetFile.txtFileName.Text, "\")
If retcode = 0 Then 'If path not specified then add
pathandname = Path + frmGetFile.txtFileName
Else
pathandname = frmGetFile.txtFileName
End If
End If
'Set the frmgetfile.tag to selected file path and name
frmGetFile.Tag = pathandname
End Sub
Sub procTrash ()
Dim Filenum As Integer
Dim Filesize As Integer
On Error GoTo JDELETE
If curForm = fGet Then
If frmGetFile.txtFileName.Text = "" Then
Exit Sub
End If
Else
If frmGetFile.Tag = "" Then
curForm = fGet
frmGetFile.Show 1
curForm = fMain
If frmGetFile.Tag = "" Then
Exit Sub
End If
End If
End If
'Insert drive and path name
procInsPath
'Get a free file number
Filenum = FreeFile
'Get file size
Filesize = FileLen(frmGetFile.Tag) - 2
If Filesize > 0 Then
If Filesize > szbuff Then
Filesize = szbuff
End If
buffer = Space(Filesize)
'Open file
Open frmGetFile.Tag For Output As Filenum
'Output spaces to file
Print #Filenum, buffer
'Close file
Close Filenum
End If
JDELETE:
'Delete file
Kill frmGetFile.Tag
frmGetFile.txtFileName.Text = ""
'Update file list
frmGetFile.filFiles.Refresh
Exit Sub
End Sub